home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 04 - 1988 / 04.10 Oct 88 / Transfer DA Code Update / DRVR.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-01-21  |  20.5 KB  |  879 lines  |  [TEXT/MPS ]
  1. (*******************************************************************
  2.     
  3.     DRVR.pas
  4.     
  5.     Transfer DA source.
  6.     
  7.     (c) 1988, by Clifford Story & Attic Software
  8.     
  9. *******************************************************************)
  10.  
  11. unit DRVR;
  12.     
  13. (******************************************************************)
  14.  
  15.     interface
  16.     
  17. (******************************************************************)
  18.     
  19.     uses macintf, Common;
  20.     
  21. (******************************************************************)
  22.  
  23.     procedure open(var device : dctlentry;
  24.                     var block :  paramblockrec);
  25.     
  26.     procedure ctl(var device : dctlentry;
  27.                     var block : paramblockrec);
  28.     
  29.     procedure close(var device : dctlentry;
  30.                     var block : paramblockrec);
  31.     
  32. (******************************************************************)
  33.  
  34.     implementation
  35.     
  36. (******************************************************************)
  37.     
  38.     procedure killda(var device : dctlentry;
  39.                     var block : paramblockrec); external;
  40.     
  41.     procedure setdisk(theflag : logical); external;
  42.     function getdisk : logical; external;
  43.     
  44. (******************************************************************)
  45.     
  46.     procedure launch(config : integer; name : ptr); inline $204F, $A9F2;
  47.     
  48.     {    movea.l        A7,A0
  49.         _launch                    }
  50.     
  51. (******************************************************************)
  52.     
  53.     procedure callMDEF(message : integer; themenu : menuhandle;
  54.                     static menurect : rect; hitpoint : point;
  55.                     var whichitem : integer; address : ptr);
  56.                     inline $205F, $4E90;
  57.  
  58. (******************************************************************)
  59.         
  60.     procedure centerdialog(globals : ghandle;
  61.                     thetype : ostype; theid : integer);
  62.         
  63.         var
  64.             thehandle        :    alertthndl;
  65.         
  66.         begin
  67.             
  68.             with globals^^ do begin
  69.                 
  70.                 thehandle := alertthndl(getresource(thetype,
  71.                                 resfactor + theid));
  72.                 hlock(handle(thehandle));
  73.                 with thehandle^^ do begin
  74.                     
  75.                     with boundsrect do
  76.                         setrect(boundsrect, 0, 0,
  77.                                         right - left, bottom - top);
  78.                     
  79.                     with QDglobals^.screenbits.bounds,
  80.                                     boundsrect.botright do
  81.                         offsetrect(boundsrect, (right - left - h) div 2,
  82.                                         (bottom - top - v + 2 * menuheight) div 3);
  83.                 
  84.                 end;
  85.                 hunlock(handle(thehandle));
  86.             
  87.             end;
  88.         
  89.         end;
  90.     
  91. (******************************************************************)
  92.     
  93.     procedure message(globals : ghandle;
  94.                     static string1, string2, string3, string4 : str255);
  95.         
  96.         var
  97.             dummy                :    integer;
  98.         
  99.         begin
  100.             
  101.             initcursor;
  102.             paramtext(string1, string2, string3, string4);
  103.             centerdialog(globals, 'ALRT', messagedialog);
  104.             dummy := alert(globals^^.resfactor + messagedialog, nil);
  105.         
  106.         end;
  107.         
  108. (******************************************************************)
  109.     
  110.     procedure showscreen(globals : ghandle; theitem : integer);
  111.     
  112.         var
  113.             itemname            :    str255;
  114.             savedport        :    grafptr;
  115.             dummy                :    integer;
  116.             newport            :    grafport;
  117.             thepicture        :    pichandle;
  118.             therect            :    rect;
  119.  
  120.         begin
  121.             
  122.             with globals^^ do begin
  123.         
  124.                 initcursor;
  125.                 getport(savedport);
  126.                 openport(@newport);
  127.                 setport(@newport);
  128.                 
  129.                 thepicture := pichandle(getresource('PICT',
  130.                                 resfactor + 1000 + theitem));
  131.                 with thepicture^^.picframe do
  132.                     setrect(therect, 0, 0, right - left, bottom - top);
  133.                 with QDglobals^.screenbits.bounds, therect.botright do
  134.                     offsetrect(therect, (right - left - h) div 2,
  135.                                     (bottom - top - v) div 3);
  136.                 drawpicture(thepicture, therect);
  137.                 
  138.                 repeat until button;
  139.                 
  140.                 closeport(@newport);
  141.                 drawmenubar;
  142.                 paintbehind(windowpeek(frontwindow),
  143.                                 rgnhandle(longpointer(grayrgn)^));
  144.                 
  145.                 setport(savedport);
  146.                 flushevents(everyevent, 0);
  147.             
  148.             end;
  149.  
  150.         end;
  151.         
  152. (******************************************************************)
  153.  
  154.     function diskfilter(theitem : integer;
  155.                     thedialog : dialogptr) : integer;
  156.         
  157.         var
  158.             thetype            :    integer;
  159.             thehandle        :    handle;
  160.             therect            :    rect;
  161.             
  162.         begin
  163.             
  164.             if theitem = getopen then begin
  165.                 getditem(thedialog, geteject, thetype, thehandle, therect);
  166.                 setdisk(controlhandle(thehandle)^^.contrlhilite = 255);
  167.             end;
  168.             
  169.             diskfilter := theitem;
  170.             
  171.         end;
  172.     
  173. (******************************************************************)
  174.  
  175.     procedure newtransfer(globals : ghandle);
  176.         
  177.         label
  178.             100;
  179.         
  180.         var
  181.             thepoint            :    point;
  182.             thelist            :    sftypelist;
  183.             thereply            :    sfreply;
  184.             theblock            :    paramblockrec;
  185.             anerror            :    integer;
  186.             thehandle        :    handle;
  187.             homedisk            :    integer;
  188.             thecount            :    integer;
  189.             index                :    integer;
  190.             
  191.         begin
  192.             
  193.             with QDglobals^.screenbits.bounds do
  194.                 setpt(thepoint, (right - left - 348) div 2,
  195.                                 (bottom - top - 200
  196.                                 + 2 * globals^^.menuheight) div 3);
  197.             thelist[0] := 'APPL';
  198.             
  199.             sfgetfile(thepoint, '', nil, 1, thelist, @diskfilter, thereply);
  200.             
  201.             if thereply.good then with globals^^ do begin
  202.                 
  203.                 with theblock do begin
  204.                     iocompletion := nil;
  205.                     newappl.volume[0] := chr(0);
  206.                     ionameptr := @newappl.volume;
  207.                     if shortpointer(fsfcblen)^ < 0 then
  208.                         iovrefnum := thereply.vrefnum
  209.                     else
  210.                         iovrefnum := - shortpointer(sfsavedisk)^;
  211.                     iovolindex := 0;
  212.                 end;
  213.                 anerror := pbgetvinfo(@theblock, false);
  214.                 if anerror <> noerr then begin
  215.                     message(globals,
  216.                                     'Sorry - the transfer failed.  I cou',
  217.                                     'ldn''t get the volume name.', '', '');
  218.                     choice := 0;
  219.                     goto 100;
  220.                 end;
  221.                 
  222.                 newappl.directory := longpointer(curdirstore)^;
  223.                 blockmove(@thereply.fname, @newappl.name, 32);
  224.                 choice := - 1;
  225.                 
  226.                 thehandle := getresource('MDEF', resfactor + mdefnum);
  227.                 homedisk := homeresfile(thehandle);
  228.                 if homedisk = 0 then
  229.                     homedisk := shortpointer(sysmap)^;
  230.                 anerror := getvrefnum(homedisk, homedisk);
  231.                 
  232.                 if getdisk or (theblock.iovrefnum = homedisk) then begin
  233.                         
  234.                     thecount := menudata^^.count + 1;
  235.                     menudata^^.count := thecount;
  236.                     sethandlesize(handle(menudata),
  237.                                     2 + thecount * sizeof(tline));
  238.                     
  239.                     hlock(handle(menudata));
  240.                     with menudata^^ do begin
  241.                         
  242.                         for index := 1 to thecount do
  243.                             if (iucompstring(appl[index].name,
  244.                                             thereply.fname) > 0) then begin
  245.                                 thecount := index;
  246.                                 leave;
  247.                             end;
  248.                         
  249.                         blockmove(@appl[thecount], @appl[thecount + 1],
  250.                                         gethandlesize(handle(menudata))
  251.                                         - long(@appl[thecount + 1])
  252.                                         + long(menudata^));
  253.                         
  254.                         blockmove(@newappl, @appl[thecount], sizeof(tline));
  255.                         
  256.                     end;
  257.                     hunlock(handle(menudata));
  258.                     
  259.                     choice := thecount;
  260.                 
  261.                 end;
  262.                 
  263.                 message(globals,
  264.                                 'Now quit to go to “', thereply.fname,
  265.                                 '”.', '');
  266.             
  267.     100:    end;
  268.             
  269.         end;
  270.         
  271. (******************************************************************)
  272.  
  273.     procedure deleteappl(globals : ghandle; theappl : integer);
  274.         
  275.         begin
  276.             
  277.             with globals^^ do begin
  278.                 
  279.                 hlock(handle(menudata));
  280.                 with menudata^^ do begin
  281.                     
  282.                     count := count - 1;
  283.                     blockmove(@appl[theappl + 1], @appl[theappl],
  284.                                     gethandlesize(handle(menudata))
  285.                                     - long(@appl[theappl + 1])
  286.                                     + long(menudata^));
  287.                 
  288.                 end;
  289.                 hunlock(handle(menudata));
  290.                 
  291.                 sethandlesize(handle(menudata), 
  292.                                 gethandlesize(handle(menudata))
  293.                                 - sizeof(tline));
  294.             
  295.             end;
  296.         
  297.         end;
  298.         
  299. (******************************************************************)
  300.         
  301.     procedure dotheok(thewindow : windowptr; theitem : integer);
  302.             
  303.         var
  304.             thetype            :    integer;
  305.             thehandle        :    handle;
  306.             therect            :    rect;
  307.             
  308.         begin
  309.         
  310.             getditem(thewindow, ok, thetype, thehandle, therect);
  311.         
  312.             pensize(3, 3);
  313.             insetrect(therect, -4, -4);
  314.             frameroundrect(therect, 16, 16);
  315.             pensize(1, 1);
  316.                 
  317.         end;
  318.         
  319. (******************************************************************)
  320.         
  321.     procedure dothelist(thewindow : windowptr; theitem : integer);
  322.             
  323.         var
  324.             thetype            :    integer;
  325.             thehandle        :    handle;
  326.             therect            :    rect;
  327.             
  328.         begin
  329.         
  330.             lupdate(thewindow^.visrgn, listhandle(getwrefcon(thewindow)));
  331.             
  332.             getditem(thewindow, theitem, thetype, thehandle, therect);
  333.             insetrect(therect, - 1, - 1);
  334.             framerect(therect);
  335.                 
  336.         end;
  337.         
  338. (******************************************************************)
  339.         
  340.     procedure dotheline(thewindow : windowptr; theitem : integer);
  341.             
  342.         var
  343.             thetype            :    integer;
  344.             thehandle        :    handle;
  345.             therect            :    rect;
  346.             
  347.         begin
  348.         
  349.             getditem(thewindow, theitem, thetype, thehandle, therect);
  350.         
  351.             moveto(therect.left, therect.top);
  352.             lineto(therect.right, therect.top);
  353.                 
  354.         end;
  355.         
  356. (******************************************************************)
  357.     
  358.     function editfilter(thedialog : dialogptr;
  359.                     var theevent : eventrecord;
  360.                     var theitem : integer): logical;
  361.         
  362.         var
  363.             thekey            :    integer;
  364.             thepoint            :    point;
  365.             thetype            :    integer;
  366.             thehandle        :    handle;
  367.             therect            :    rect;
  368.         
  369.         begin
  370.             
  371.             editfilter := false;
  372.             
  373.             if theevent.what = keydown then begin
  374.                 
  375.                 thekey := bitand(charcodemask, theevent.message);
  376.                 if (thekey = enterkey) or (thekey = returnkey) then begin
  377.                     theitem := ok;
  378.                     editfilter := true;
  379.                 end else if thekey = periodkey then begin
  380.                     theitem := cancel;
  381.                     editfilter := true;
  382.                 end else if (thekey = ord('d')) or (thekey = ord('D')) then begin
  383.                     theitem := editdelete;
  384.                     editfilter := true;
  385.                 end;
  386.             
  387.             end else if theevent.what = mousedown then begin
  388.                 
  389.                 thepoint := theevent.where;
  390.                 
  391.                 globaltolocal(thepoint);
  392.                 getditem(thedialog, editlist, thetype, thehandle, therect);
  393.                 
  394.                 if ptinrect(thepoint, therect) then begin
  395.                     editfilter := true;
  396.                     if lclick(thepoint, 0, listhandle(getwrefcon(thedialog))) then
  397.                         ;
  398.                     theitem := editlist;
  399.                 end;
  400.             
  401.             end;
  402.         
  403.         end;
  404.     
  405. (******************************************************************)
  406.  
  407.     procedure edittransfer(globals : ghandle);
  408.         
  409.         var
  410.             savedport        :    grafptr;
  411.             thedialog        :    dialogptr;
  412.             therecord        :    dialogrecord;
  413.             thetype            :    integer;
  414.             thehandle        :    handle;
  415.             therect            :    rect;
  416.             bounds            :    rect;
  417.             thepoint            :    point;
  418.             thelist            :    listhandle;
  419.             response            :    integer;
  420.             
  421.         begin
  422.             
  423.             thehandle := getresource('PACK', 0);
  424.             if thehandle = nil then
  425.                 message(globals,
  426.                                 'Sorry - You will need System 3.0 or ',
  427.                                 'later to edit the menu.  You can era',
  428.                                 'se the entire menu by dragging the T',
  429.                                 'ransfer Data file to the Trash.')
  430.             else with globals^^ do begin
  431.                 
  432.                 getport(savedport);
  433.                 centerdialog(globals, 'DLOG', editdialog);
  434.                 thedialog := getnewdialog(resfactor + editdialog,
  435.                                 @therecord, pointer(-1));
  436.                 setport(thedialog);
  437.     
  438.                 getditem(thedialog, themask, thetype, thehandle, therect);
  439.                 thehandle := handle(@dotheok);
  440.                 setditem(thedialog, themask, useritem, thehandle, therect);
  441.     
  442.                 getditem(thedialog, editlist, thetype, thehandle, therect);
  443.                 thehandle := handle(@dothelist);
  444.                 setditem(thedialog, editlist, useritem, thehandle, therect);
  445.                 
  446.                 therect.right := therect.right - 15;
  447.                 setrect(bounds, 0, 0, 1, menudata^^.count);
  448.                 setpt(thepoint, therect.right - therect.left, 16);
  449.                 thelist := lnew(therect, bounds, thepoint,
  450.                                 resfactor + ldefnum, thedialog,
  451.                                 true, false, false, true);
  452.                 thelist^^.refcon := long(menudata);
  453.                 setwrefcon(thedialog, long(thelist));
  454.     
  455.                 getditem(thedialog, editline, thetype, thehandle, therect);
  456.                 thehandle := handle(@dotheline);
  457.                 setditem(thedialog, editline, useritem, thehandle, therect);
  458.     
  459.                 showwindow(thedialog);
  460.                 
  461.                 thehandle := handle(menudata);
  462.                 response := handtohand(thehandle);
  463.             
  464.                 repeat
  465.                     
  466.                     modaldialog(@editfilter, response);
  467.                     
  468.                     if response = editdelete then begin
  469.                         setpt(thepoint, 0, 0);
  470.                         if lgetselect(true, thepoint, thelist) then begin
  471.                             deleteappl(globals, thepoint.v + 1);
  472.                             ldelrow(1, thepoint.v, thelist);
  473.                         end;
  474.                     end;
  475.                     
  476.                 until (response = ok) or (response = cancel);
  477.                 
  478.                 if response = ok then begin
  479.                     calcmenusize(themenu);
  480.                     message(globals,
  481.                                     'This cancels any earlier choice ',
  482.                                     'from the menu.', '', '');
  483.                     choice := 0;
  484.                     disposhandle(thehandle);
  485.                 end else begin
  486.                     disposhandle(handle(menudata));
  487.                     menudata := thandle(thehandle);
  488.                     thehandle := themenu^^.menuproc;
  489.                     hlock(thehandle);
  490.                     callMDEF(msethandle, themenu, therect,
  491.                                     point(menudata), thetype, thehandle^);
  492.                     hunlock(thehandle);
  493.                 end;
  494.                 
  495.                 ldispose(thelist);
  496.                 closedialog(thedialog);
  497.                 setport(savedport);
  498.             
  499.             end;
  500.             
  501.         end;
  502.         
  503. (******************************************************************)
  504.  
  505.     procedure dofinder(globals : ghandle);
  506.         
  507.         var
  508.             thecount            :    integer;
  509.             
  510.         begin
  511.             
  512.             globals^^.choice := 0;
  513.             message(globals,
  514.                             'Now quit to go to the Finder',
  515.                             '', '', '');
  516.             
  517.         end;
  518.         
  519. (******************************************************************)
  520.  
  521.     procedure clickmenu(globals : ghandle; theitem : integer);
  522.         
  523.         var
  524.             thecount            :    integer;
  525.             
  526.         begin
  527.             
  528.             case theitem of
  529.                 aboutitem    :    showscreen(globals, theitem);
  530.                 atticitem    :    showscreen(globals, theitem);
  531.                 transitem    :    newtransfer(globals);
  532.                 edititem        :    edittransfer(globals);
  533.                 finderitem    :    dofinder(globals);
  534.             otherwise
  535.                  with globals^^ do begin
  536.                     choice := theitem - 7;
  537.                     blockmove(@menudata^^.appl[choice], @newappl, sizeof(tline));
  538.                     message(globals,
  539.                                     'Now quit to go to your choice',
  540.                                     '', '', '');
  541.                 end;
  542.             end;
  543.             
  544.         end;
  545.         
  546. (******************************************************************)
  547.         
  548.     procedure getdata(theresource : handle; var thedata : thandle;
  549.                     var thevolume : integer; var thefile : integer);
  550.         
  551.         label
  552.             100;
  553.         
  554.         var
  555.             homedisk            :    integer;
  556.             theblock            :    mixedblock;
  557.             anerror            :    integer;
  558.             thesize            :    long;
  559.         
  560.         begin
  561.             
  562.             thedata := nil;
  563.             
  564.             thevolume := homeresfile(theresource);
  565.             if thevolume = 0 then
  566.                 thevolume := shortpointer(sysmap)^;
  567.             if getvrefnum(thevolume, thevolume) <> noerr then
  568.                 goto 100;
  569.             
  570.             if shortpointer(fsfcblen)^ < 0 then
  571.                 homedisk := thevolume
  572.             else begin
  573.                 
  574.                 with theblock.hfsblock do begin
  575.                     iocompletion := nil;
  576.                     ionameptr := nil;
  577.                     iovrefnum := thevolume;
  578.                     iovolindex := 0;
  579.                 end;
  580.                 if pbhgetvinfo(@theblock, false) <> noerr then
  581.                     goto 100;
  582.                 
  583.                 with theblock.dirblock do begin
  584.                     iowddirid := theblock.hfsblock.iovfndrinfo[1];
  585.                     iowdprocid := procid;
  586.                 end;
  587.                 if pbopenwd(@theblock, false) <> noerr then
  588.                     goto 100;
  589.                 
  590.                 homedisk := theblock.dirblock.iovrefnum;
  591.             
  592.             end;
  593.             
  594.             anerror := fsopen('Transfer Data', homedisk, thefile);
  595.             if anerror <> noerr then begin
  596.                 
  597.                 if anerror <> fnferr then
  598.                     goto 100;
  599.                 
  600.                 anerror := create('Transfer Data', homedisk, '....', '....');
  601.                 if anerror <> noerr then
  602.                     goto 100;
  603.                 
  604.                 anerror := fsopen('Transfer Data', homedisk, thefile);
  605.                 if anerror <> noerr then
  606.                     goto 100;
  607.                 
  608.                 thedata := thandle(newhandle(2));
  609.                 if thedata <> nil then
  610.                     thedata^^.count := 0;
  611.                 goto 100;
  612.                 
  613.             end;
  614.             
  615.             anerror := geteof(thefile, thesize);
  616.             if anerror <> noerr then begin
  617.                 anerror := fsclose(thefile);
  618.                 goto 100;
  619.             end;
  620.             
  621.             thedata := thandle(newhandle(thesize));
  622.             if thedata = nil then begin
  623.                 anerror := fsclose(thefile);
  624.                 goto 100;
  625.             end;
  626.             
  627.             hlock(handle(thedata));
  628.             anerror := fsread(thefile, thesize, ptr(thedata^));
  629.             if anerror <> noerr then begin
  630.                 disposhandle(handle(thedata));
  631.                 thedata := nil;
  632.                 anerror := fsclose(thefile);
  633.             end;
  634.             
  635.             if thedata <> nil then
  636.                 hunlock(handle(thedata));
  637.         
  638. 100:    end;
  639.     
  640. (******************************************************************)
  641.  
  642.     procedure setdata(globals : ghandle);
  643.         
  644.         var
  645.             thesize            :    long;
  646.             anerror            :    integer;
  647.         
  648.         begin
  649.             
  650.             with globals^^ do begin
  651.                 
  652.                 hlock(handle(menudata));
  653.                 thesize := 2 + menudata^^.count * sizeof(tline);
  654.                 anerror := setfpos(menufile, fsfromstart, 0);
  655.                 anerror := fswrite(menufile, thesize, ptr(menudata^));
  656.                 anerror := seteof(menufile, thesize);
  657.                 anerror := fsclose(menufile);
  658.                 anerror := flushvol(nil, menudisk);
  659.                 hunlock(handle(menudata));
  660.             
  661.             end;
  662.         
  663.         end;
  664.     
  665. (******************************************************************)
  666.  
  667.     procedure transferappl(globals : ghandle;
  668.                     var device : dctlentry;
  669.                     var block : paramblockrec);
  670.         
  671.         label
  672.             100;
  673.         
  674.         var
  675.             thesize            :    long;
  676.             anerror            :    integer;
  677.             thelength        :    integer;
  678.             thestring        :    str255;
  679.             theblock            :    mixedblock;
  680.             theinfo            :    finfo;
  681.             thehandle        :    handle;
  682.             therect            :    rect;
  683.             theitem            :    integer;
  684.         
  685.         begin
  686.             
  687.             setdata(globals);
  688.             
  689.             if globals^^.choice <> 0 then with globals^^, newappl do begin
  690.                 
  691.                 thelength := ord(volume[0]) + 1;
  692.                 blockmove(@volume, @thestring, thelength);
  693.                 thestring[0] := chr(thelength);
  694.                 thestring[thelength] := ':';
  695.                 
  696.                 with theblock.volblock do begin
  697.                     iocompletion := nil;
  698.                     ionameptr := @thestring;
  699.                     iovolindex := - 1;
  700.                 end;
  701.                 anerror := pbgetvinfo(@theblock, false);
  702.                 if anerror <> noerr then
  703.                     goto 100;
  704.                 
  705.                 blockmove(@name, @thestring, 32);
  706.                 
  707.                 if shortpointer(fsfcblen)^ = -1 then
  708.                     anerror := setvol(nil, theblock.volblock.iovrefnum)
  709.                 else with theblock.dirblock do begin
  710.                     
  711.                     iocompletion := nil;
  712.                     ionameptr := nil;
  713.                     iovrefnum := theblock.volblock.iovrefnum;
  714.                     iowdprocid := procid;
  715.                     iowddirid := directory;
  716.                     anerror := pbopenwd(@theblock, false);
  717.                     
  718.                     if anerror = noerr then
  719.                         anerror := setvol(nil, iovrefnum)
  720.                     
  721.                 end;
  722.                 
  723.                 if anerror = noerr then begin
  724.                     anerror := getfinfo(thestring, 0, theinfo);
  725.                     if (anerror = noerr) and (theinfo.fdtype = 'APPL') then begin
  726.                         killda(device, block);
  727.                         launch(0, @thestring);
  728.                     end;
  729.                 end;
  730.                 
  731.         100:    getdata(themenu^^.menuproc, menudata, menudisk, menufile);
  732.                 if menudata <> nil then begin
  733.                     deleteappl(globals, choice);
  734.                     setdata(globals);
  735.                 end;
  736.                 
  737.                 message(globals,
  738.                                 'I can''t find “', thestring,
  739.                                 '”.  Returning to the Finder.', '');
  740.             
  741.             end;
  742.         
  743.         end;
  744.     
  745. (******************************************************************)
  746.         
  747.     procedure open(var device : dctlentry;
  748.                     var block :  paramblockrec);
  749.         
  750.         label
  751.             100;
  752.         
  753.         var
  754.             globals            :    ghandle;
  755.             thehandle        :    handle;
  756.             therect            :    rect;
  757.             theitem            :    integer;
  758.         
  759.         begin
  760.             
  761.             if device.dctldelay <> 0 then begin
  762.                 sysbeep(10);
  763.                 goto 100;
  764.             end;
  765.             
  766.             globals := ghandle(newhandle(sizeof(grecord)));
  767.             if globals = nil then begin
  768.                 sysbeep(10);
  769.                 goto 100;
  770.             end;
  771.             
  772.             hlock(handle(globals));
  773.             with globals^^ do begin
  774.                 
  775.                 unitnumber := device.dctlrefnum;
  776.                 resfactor := $BFE0 - 32 * unitnumber - 1000;
  777.                 
  778.                 if bittst(ptr(rom85), 0) then
  779.                     menuheight := 20
  780.                 else
  781.                     menuheight := shortpointer(mbarheight)^;
  782.                 
  783.                 if getresource('PACK', 0) <> nil then begin
  784.                     if (ngettrapaddress($A88F, tooltrap)
  785.                                     <> ngettrapaddress($A89F, tooltrap)) then begin
  786.                         message(globals, 'Sorry, the Transfer DA doesn''t ',
  787.                                         'work under the Multifinder.', '', '');
  788.                         killda(device, block);
  789.                         goto 100;
  790.                     end;
  791.                 end;
  792.             
  793.                 themenu := getmenu(resfactor + menunum);
  794.                 thehandle := getresource('MDEF', resfactor + mdefnum);
  795.                 themenu^^.menuproc := thehandle;
  796.                 getdata(thehandle, menudata, menudisk, menufile);
  797.                 if menudata = nil then begin
  798.                     message(globals,
  799.                                     'Sorry - Failed to read the “Transfer ',
  800.                                     'Data” file.', '', '');
  801.                     disposhandle(handle(globals));
  802.                     killda(device, block);
  803.                     goto 100;
  804.                 end;
  805.                 
  806.                 hlock(thehandle);
  807.                 callMDEF(msethandle, themenu, therect,
  808.                                 point(menudata), theitem, thehandle^);
  809.                 hunlock(thehandle);
  810.                 
  811.                 insertmenu(themenu, 0);
  812.                 calcmenusize(themenu);
  813.                 drawmenubar;
  814.                 
  815.                 choice := 0;
  816.                     
  817.                 device.dctlmenu := resfactor + menunum;
  818.                 device.dctlstorage := handle(globals);
  819.                 device.dctldelay := 32000;
  820.             
  821.             end;
  822.             hunlock(handle(globals));
  823.         
  824. 100:    end;
  825.     
  826. (******************************************************************)
  827.     
  828.     procedure ctl(var device : dctlentry;
  829.                     var block : paramblockrec);
  830.         
  831.         label
  832.             100;
  833.  
  834.         var
  835.             globals            :    ghandle;
  836.         
  837.         begin
  838.             
  839.             if device.dctldelay < 32000 then
  840.                 goto 100;
  841.             
  842.             device.dctldelay := 31000;
  843.             globals := ghandle(device.dctlstorage);
  844.             
  845.             hlock(handle(globals));
  846.             if block.cscode = accmenu then
  847.                 clickmenu(globals, block.csparam[1])
  848.             else if block.cscode = -1 then
  849.                 transferappl(globals, device, block);
  850.             hunlock(handle(globals));
  851.             
  852.             device.dctldelay := 32000;
  853.         
  854. 100:    end;
  855.     
  856. (******************************************************************)
  857.     
  858.     procedure close(var device : dctlentry;
  859.                     var block : paramblockrec);
  860.         
  861.         var
  862.             globals            :    ghandle;
  863.         
  864.         begin
  865.             
  866.             if device.dctldelay = 32000 then begin
  867.                 globals := ghandle(device.dctlstorage);
  868.                 hlock(handle(globals));
  869.                 transferappl(globals, device, block);
  870.             end;
  871.         
  872.         end;
  873.     
  874. (******************************************************************)
  875.             
  876.     end.
  877.     
  878. (******************************************************************)
  879.